home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / GFXFX2.ZIP / SCR_SIN.PAS < prev    next >
Pascal/Delphi Source File  |  1995-02-14  |  2KB  |  65 lines
  1.  
  2. program sinusscroll; { SCR_SIN.PAS }
  3. { Enhanced sinus-scroll, by Bas van Gaalen }
  4. uses u_vga,u_kb;
  5.  
  6. const
  7.   sofs=140;
  8.   samp=40;
  9.   slen=255;
  10.   size=2;
  11.   curve=3;
  12.   xmax=279 div size;
  13.   ymax=7;
  14.   scrspd=-1;
  15.   scrtxt:string=
  16.     ' Hai world... This looks a bit like the scroll of the second part'+
  17.     ' of Future Crew''s Unreal demo (part one)...     It''s not filled'+
  18.     ' but it sure looks nicer (imho)...                               ';
  19.  
  20. var
  21.   stab:array[0..slen] of word;
  22.  
  23. procedure scroll;
  24. type
  25.   scrarray=array[0..xmax,0..ymax] of byte;
  26.   posarray=array[0..xmax,0..ymax] of word;
  27. var
  28.   postab:posarray;
  29.   bitmap:scrarray;
  30.   x,i,sinidx:word;
  31.   y,scridx,curchar:byte;
  32. begin
  33.   fillchar(bitmap,sizeof(bitmap),0);
  34.   fillchar(postab,sizeof(postab),0);
  35.   scridx:=1; sinidx:=0;
  36.   repeat
  37.     curchar:=ord(scrtxt[scridx]);
  38.     scridx:=1+scridx mod length(scrtxt);
  39.     for i:=0 to 7 do begin
  40.       move(bitmap[1,0],bitmap[0,0],(ymax+1)*xmax);
  41.       for y:=0 to ymax do
  42.         if ((mem[seg(font^):ofs(font^)+8*curchar+y] shl i) and 128)<>0 then
  43.           bitmap[xmax,y]:=((scridx+y-i) mod 60)+32 else bitmap[xmax,y]:=0;
  44.       vretrace;
  45.       for x:=0 to xmax do
  46.         for y:=0 to ymax do begin
  47.           mem[u_vidseg:postab[x,y]]:=0;
  48.           postab[x,y]:=(size*y+stab[(sinidx+x+curve*y) mod slen])*320+
  49.             size*x+stab[(x+y) mod slen]-sofs;
  50.           mem[u_vidseg:postab[x,y]]:=bitmap[x,y];
  51.         end;
  52.       sinidx:=(sinidx+scrspd) mod slen;
  53.     end;
  54.   until keypressed;
  55. end;
  56.  
  57. var i:word;
  58. begin
  59.   getfont(font8x8);
  60.   for i:=0 to slen do stab[i]:=round(sin(i*4*pi/slen)*samp)+sofs;
  61.   setvideo($13);
  62.   scroll;
  63.   setvideo(u_lm);
  64. end.
  65.